home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / BARNET / COMPILER / SATHER / !Sather / System / Common / h / fortran < prev    next >
Text File  |  1996-08-20  |  6KB  |  195 lines
  1. #ifndef _FORTRAN_H_
  2. #define _FORTRAN_H_
  3.  
  4. typedef long int    F_INTEGER;
  5. typedef long int    F_LOGICAL;
  6. typedef float       F_REAL;
  7. typedef double      F_DOUBLE;
  8. typedef char        F_CHARACTER;  /*immutable FORTRAN CHARACTER*1 type*/
  9.  
  10. typedef long int   F_LENGTH;  /* length of FOTRTAN CHARACTER types */
  11.  
  12. typedef struct {
  13.   F_REAL re, im;
  14. } F_COMPLEX_struct;
  15. typedef F_COMPLEX_struct F_COMPLEX;
  16. static F_COMPLEX F_COMPLEX_zero;
  17.  
  18. typedef struct {
  19.   F_DOUBLE re, im;
  20. } F_DOUBLE_COMPLEX_struct;
  21. typedef F_DOUBLE_COMPLEX_struct F_DOUBLE_COMPLEX;
  22. static F_DOUBLE_COMPLEX F_DOUBLE_COMPLEX_zero;
  23.  
  24. typedef struct {
  25.   F_CHARACTER *address;  /*Fortran string address*/
  26.   F_LENGTH size;
  27. } F_STRING_struct;
  28. typedef F_STRING_struct *F_STRING;
  29.  
  30. typedef struct F_HANDLER_struct {
  31.   OB_HEADER header;
  32.   void (*funcptr)(void *);
  33. } *F_HANDLER;
  34.  
  35. /* A pretty dumn definition for F_ROUT */
  36. /* It is just fine to be passed to Fortran as is */
  37. typedef void *F_ROUT;  
  38.  
  39. /* FORTRAN ARRAYS */
  40. typedef F_INTEGER *F_ARRAY_F_INTEGER;
  41. typedef F_INTEGER *F_ARRAY2_F_INTEGER;
  42. typedef F_INTEGER *F_ARRAY3_F_INTEGER;
  43.  
  44. typedef F_LOGICAL *F_ARRAY_F_LOGICAL;
  45. typedef F_LOGICAL *F_ARRAY2_F_LOGICAL;
  46. typedef F_LOGICAL *F_ARRAY3_F_LOGICAL;
  47.  
  48. typedef F_REAL *F_ARRAY_F_REAL;
  49. typedef F_REAL *F_ARRAY2_F_REAL;
  50. typedef F_REAL *F_ARRAY3_F_REAL;
  51.  
  52. typedef F_DOUBLE *F_ARRAY_F_DOUBLE;
  53. typedef F_DOUBLE *F_ARRAY2_F_DOUBLE;
  54. typedef F_DOUBLE *F_ARRAY3_F_DOUBLE;
  55.  
  56. typedef F_CHARACTER *F_ARRAY_F_CHARACTER;
  57. typedef F_CHARACTER *F_ARRAY2_F_CHARACTER;
  58. typedef F_CHARACTER *F_ARRAY3_F_CHARACTER;
  59.  
  60. typedef F_COMPLEX *F_ARRAY_F_COMPLEX;
  61. typedef F_COMPLEX *F_ARRAY2_F_COMPLEX;
  62. typedef F_COMPLEX *F_ARRAY3_F_COMPLEX;
  63.  
  64. typedef F_DOUBLE_COMPLEX *F_ARRAY_F_DOUBLE_COMPLEX;
  65. typedef F_DOUBLE_COMPLEX *F_ARRAY2_F_DOUBLE_COMPLEX;
  66. typedef F_DOUBLE_COMPLEX *F_ARRAY3_F_DOUBLE_COMPLEX;
  67.  
  68. typedef struct F_INTEGER_boxed_struct { OB_HEADER header; F_INTEGER immutable_part; } *F_INTEGER_boxed;
  69. typedef struct F_LOGICAL_boxed_struct { OB_HEADER header; F_LOGICAL immutable_part; } *F_LOGICAL_boxed;
  70. typedef struct F_REAL_boxed_struct { OB_HEADER header; F_REAL immutable_part; } *F_REAL_boxed;
  71. typedef struct F_DOUBLE_boxed_struct { OB_HEADER header; F_DOUBLE immutable_part; } *F_DOUBLE_boxed;
  72. typedef struct F_CHARACTER_boxed_struct { OB_HEADER header; F_CHARACTER immutable_part; } *F_CHARACTER_boxed;
  73. typedef struct F_COMPLEX_boxed_struct { OB_HEADER header; F_COMPLEX immutable_part; } *F_COMPLEX_boxed;
  74. typedef struct F_DOUBLE_COMPLEX_boxed_struct { OB_HEADER header; F_DOUBLE_COMPLEX immutable_part; } *F_DOUBLE_COMPLEX_boxed;
  75.  
  76.  
  77. /* A maximum string length allowed to be return by fortran calls */
  78. /* This will go when we have F_CARACTER_N types */
  79. #define F_CHARACTER_RETURN_SIZE  32
  80.  
  81. #define INTF_INTEGER(x)         ((F_INTEGER)(x))
  82. #define F_INTEGERINT(x)         ((INT)(x))
  83. #define F_INTEGERPLUS(a,b)      a+b
  84. #define F_INTEGERMINUS(a,b)     a-b
  85. #define F_INTEGERTIMES(a,b)     a*b
  86. #define F_INTEGERDIV(a,b)       INTDIV(a,b)
  87. #define F_INTEGERIS_LT(a,b)    (a<b)
  88. #define F_INTEGERIS_LEQ(a,b)   (a<=b)
  89. #define F_INTEGERIS_GT(a,b)    (a>b)
  90. #define F_INTEGERIS_GEQ(a,b)   (a>=b)
  91.  
  92.  
  93. #define FLTF_REAL(x)            ((F_REAL)(x))
  94. #define F_REALFLT(x)            ((FLT)(x))
  95. #define F_REALPLUS(a,b)         a+b
  96. #define F_REALMINUS(a,b)        a-b
  97. #define F_REALTIMES(a,b)        a*b
  98. #define F_REALDIV(a,b)          a/b
  99. #define F_REALIS_LT(a,b)       (a<b)
  100. #define F_REALIS_LEQ(a,b)      (a<=b)
  101. #define F_REALIS_GT(a,b)       (a>b)
  102. #define F_REALIS_GEQ(a,b)      (a>=b)
  103.  
  104.  
  105. #define FLTDF_DOUBLE(x)         ((F_DOUBLE)(x))
  106. #define F_DOUBLEFLTD(x)         ((FLTD)(x))
  107. #define F_DOUBLEPLUS(a,b)       a+b
  108. #define F_DOUBLEMINUS(a,b)      a-b
  109. #define F_DOUBLETIMES(a,b)      a*b
  110. #define F_DOUBLEDIV(a,b)        a/b
  111. #define F_DOUBLEIS_LT(a,b)      (a<b)
  112. #define F_DOUBLEIS_LEQ(a,b)     (a<=b)
  113. #define F_DOUBLEIS_GT(a,b)      (a>b)
  114. #define F_DOUBLEIS_GEQ(a,b)     (a>=b)
  115.  
  116.  
  117. #define BOOLF_LOGICAL(x)        ((F_LOGICAL)(x))
  118. #define F_LOGICALBOOL(x)        ((BOOL)(x))
  119. #define F_LOGICALNOT(x)         !x
  120. #define F_LOGICALOR(a,b)        (a||b)
  121. #define F_LOGICALAND(a,b)       (a&&b)
  122. #define F_LOGICALIS_RQ(a,b)     (a==b)
  123.  
  124.  
  125. #define CHARF_CHARACTER(x)      ((F_CHARACTER)(x))
  126. #define F_CHARACTERCHAR(x)      ((CHAR)(x))
  127. #define F_CHARACTERIS_LT(a,b)    (a<b)
  128. #define F_CHARACTERIS_LEQ(a,b)   (a<=b)
  129. #define F_CHARACTERIS_GT(a,b)    (a>b)
  130. #define F_CHARACTERIS_GEQ(a,b)   (a>=b)
  131.  
  132. #define F_STRING_COPY_TO(dest,src,size) memcpy(dest,src,size)
  133.  
  134.  
  135. #define F_INTEGER_IS_EQ(a,b)    STD_IS_EQ(a,b)
  136. #define F_REAL_IS_EQ(a,b)       STD_IS_EQ(a,b)
  137. #define F_CHARACTER_IS_EQ(a,b)  STD_IS_EQ(a,b)
  138. #define F_LOGICAL_IS_EQ(a,b)    STD_IS_EQ(a,b)
  139. #define F_DOUBLE_IS_EQ(a,b)     STD_IS_EQ(a,b)
  140. #define F_COMPLEX_IS_EQ(a,b)    (STD_IS_EQ(a.re,b.re)&&STD_IS_EQ(a.im,b.im))
  141. #define F_DOUBLE_COMPLEX_IS_EQ(a,b) (STD_IS_EQ(a.re,b.re)&&STD_IS_EQ(a.im,b.im))
  142. #define F_HANDLERINVOKE_HANDLER(h) (*(h->funcptr))(h)
  143.  
  144. #define F_INTEGER_zero          (F_INTEGER)0
  145. #define F_REAL_zero             (F_REAL)0.0
  146. #define F_LOGICAL_zero          (F_LOGICAL)0
  147. #define F_DOUBLE_zero           (F_LOGICAL)0.0
  148. #define F_CHARACTER_zero        (F_CHARACTER)CHAR_zero
  149. #define F_STRING_zero    (F_STRING)NULL
  150. #define F_HANDLER_zero          (F_HANDLER)NULL
  151. #define F_ROUT_zero             (F_ROUT)NULL
  152.  
  153. #define F_INTEGER_IS_VOID(a)    ((a)==0)
  154. #define F_REAL_IS_VOID(a)       ((a)==0.0)
  155. #define F_LOGICAL_IS_VOID(a)    ((a)==0)
  156. #define F_DOUBLE_IS_VOID(a)     ((a)==0.0)
  157. #define F_CHARACTER_IS_VOID(a)  ((a)==F_CHARACTER_zero)
  158. #define F_STRING_is_void(a) ((a)==NULL)
  159. /* These two are wrong */
  160. #define F_COMPLEX_IS_VOID(a)    ((a)==NULL)
  161. #define F_DOUBLE_COMPLEX_IS_VOID(a) ((a)==NULL)
  162.  
  163. #define F_HANDLER_IS_VOID(a)    ((a)==NULL)
  164. #define F_ROUT_IS_VOID(a)       ((a)==NULL)
  165.  
  166. #endif
  167.  
  168.  
  169.  
  170.  
  171.  
  172.  
  173.  
  174.  
  175.  
  176.  
  177.  
  178.  
  179.  
  180.  
  181.  
  182.  
  183.  
  184.  
  185.  
  186.  
  187.  
  188.  
  189.  
  190.  
  191.  
  192.  
  193.  
  194.  
  195.